home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 March / EnigmA AMIGA RUN 05 (1996)(G.R. Edizioni)(IT)[!][issue 1996-03][Skylink CD IV].iso / earcd / program / mkdt-1_2.lha / MakeDT.rexx < prev   
OS/2 REXX Batch file  |  1996-01-29  |  11KB  |  436 lines
  1. /*
  2. **    MakeDT.rexx - ARexx script to create DataType recogs
  3. **    $VER: MakeDT.rexx 1.2 (29.1.96)
  4. **    Written by Michal Letowski
  5. **
  6. **    1.0 (20.12.94) - initial version, not released
  7. **    1.1 (22.11.94) - 1st public version
  8. **    1.2 (29.1.96)  - 2nd public version
  9. **        + now can write FVER chunk
  10. **        ! fixed bug in tags conversion
  11. */
  12.  
  13. SIGNAL ON BREAK_C
  14.  
  15. PARSE ARG descrFile outFile .
  16.  
  17. IF descrFile='' THEN
  18. DO
  19.     SAY 'Usage: MakeDT <DescriptionFile> [<DestDataType>]'
  20.     EXIT 20
  21. END
  22.  
  23. IF ~OPEN(FH,descrFile,'R') THEN
  24.     CALL Error('Unable to open description file' descrFile,20)
  25.  
  26. Header.=''                                                                    /* Init header */
  27. Code.=''                                                                        /* Init code */
  28. Code.Exists=0
  29. Tools.=''                                                                        /* Init tool */
  30. DO I=1 TO 5
  31.     Tools.I.Exists=0
  32. END
  33. Tags.=''                                                                        /* Init tags */
  34. Tags.Count=1
  35.  
  36. DO LineNum=1 WHILE ~EOF(FH)
  37.     Line=READLN(FH)
  38.     IF Line='' THEN
  39.         LEAVE
  40.     Line=STRIP(Line,'L')                                            /* Remove leading spaces */
  41.     IF SUBSTR(Line,1,1)='#' THEN                            /* Skip comment */
  42.         ITERATE
  43.     PARSE VAR Line Comm '=' Value
  44.     UPPER Comm
  45.     SELECT
  46.         WHEN ABBREV('FILENAME',Comm) THEN
  47.             IF outFile='' THEN
  48.                 outFile=Value
  49.         WHEN ABBREV('DTNAME',Comm) THEN        CALL ParseDTName(Value,LineNum)
  50.         WHEN ABBREV('ID',Comm) THEN                CALL ParseID(Value,LineNum)
  51.         WHEN ABBREV('VERSION',Comm) THEN    CALL ParseVersion(Value,LineNum)
  52.         WHEN ABBREV('RECOG',Comm) THEN        CALL ParseRecog(Value,LineNum)
  53.         WHEN ABBREV('FLAGS',Comm) THEN        CALL ParseFlags(Value,LineNum)
  54.         WHEN ABBREV('CODE',Comm) THEN            CALL ParseCode(Value,LineNum)
  55.         WHEN ABBREV('TOOL',Comm) THEN            CALL ParseTool(Value,LineNum)
  56.         WHEN ABBREV('TAG',Comm) THEN            CALL ParseTag(Value,LineNum)
  57.         OTHERWISE
  58.             CALL Error('Error in line' LineNum ': Unknown command',10)
  59.     END
  60. END
  61. CALL CLOSE(FH)
  62. CALL Check(outFile)
  63. CALL Write
  64. CALL WriteFile(outFile)
  65.  
  66. EXIT
  67.  
  68.  
  69. /*
  70. **    MakeDT procedures
  71. */
  72. ParseDTName:    PROCEDURE EXPOSE Header.
  73.     PARSE ARG value,line
  74.     PARSE VAR value Header.Name ',' Header.BaseName
  75.     IF Header.Name='' | Header.BaseName='' THEN
  76.         CALL Error('Error in line' line ': <Name> and <BaseName> must not be null',10)
  77. RETURN
  78.  
  79. ParseVersion:    PROCEDURE EXPOSE Header.
  80.     PARSE ARG value,line
  81.     PARSE VAR value version '.' revision
  82.     IF ~DATATYPE(version,'W') | ~DATATYPE(revision,'W') THEN
  83.         CALL Error('Error in line' line ': <Version> or <Revision> not numeric',10)
  84.     Header.VerString='$VER:' UPPER(Header.Name) version'.'revision '('MakeDate()')'
  85. RETURN
  86.  
  87. ParseID:    PROCEDURE EXPOSE Header.
  88.     PARSE ARG value,line
  89.     PARSE VAR value Header.GroupID ',' Header.ID
  90.     IF Header.GroupID='' | Header.ID='' THEN
  91.         CALL Error('Error in line' line ': <GroupID> and <FileID> must not be null',10)
  92.     IF FIND('syst text docu soun inst musi pict anim movi',Header.GroupID)=0 THEN
  93.         CALL Error('Warning in line' line ': Unknown <GroupID>',5)
  94.     IF LENGTH(Header.GroupID)>5 | LENGTH(Header.ID)>4 THEN
  95.         CALL Error('Error in line' line ': <GroupID> and <FileID> may be up to 4 chars',10)
  96. RETURN
  97.  
  98. ParseRecog:    PROCEDURE EXPOSE Header.
  99.     PARSE ARG value,line
  100.     PARSE VAR value Header.Pattern ',' Header.Mask
  101.     Header.Mask=CDecode(Header.Mask,line)
  102.     Header.MaskLen=LENGTH(Header.Mask)%2
  103. RETURN
  104.  
  105. ParseFlags:    PROCEDURE EXPOSE Header.
  106.     PARSE ARG value,line
  107.     PARSE UPPER VAR value Type ',' Case ',' Pri
  108.     SELECT
  109.         WHEN ABBREV('BINARY',Type) THEN    Header.Flags=0
  110.         WHEN ABBREV('ASCII',Type) THEN    Header.Flags=1
  111.         WHEN ABBREV('IFF',Type) THEN        Header.Flags=2
  112.         WHEN ABBREV('OTHER',Type) THEN    Header.Flags=3
  113.         OTHERWISE
  114.             CALL Error('Error in line' line ': Type must be <Binary>, <ASCII>, <IFF> or <Other>',10)
  115.     END
  116.     IF Case='Y' THEN
  117.         Header.Flags=Header.Flags+16
  118.     SELECT
  119.         WHEN Pri='' THEN
  120.             Header.Priority=0
  121.         WHEN DATATYPE(Pri,'W') THEN
  122.             IF Pri>=0 & Pri<=65535 THEN
  123.                 Header.Priority=Pri
  124.             ELSE
  125.                 CALL Error('Error in line' line ': <Priority> must be in 0..65535 range',10)
  126.         OTHERWISE
  127.             CALL Error('Error in line' line ': <Priority> not numeric',10)
  128.     END
  129. RETURN
  130.  
  131. ParseCode:    PROCEDURE EXPOSE Code.
  132.     PARSE ARG value,line
  133.     Code.Exists=0
  134.     IF value='' THEN
  135.         RETURN
  136.     Code.Exists=OPEN(CodeFH,value,'R')
  137.     If ~Code.Exists THEN
  138.         CALL Error('Error in line' line ': <Code> file does not exist',10)
  139.     Code.Code=READCH(CodeFH,65536)
  140.     CALL CLOSE(CodeFH)
  141.     Code.Exists=1
  142. RETURN
  143.  
  144. ParseTool:    PROCEDURE EXPOSE Tools.
  145.     PARSE ARG value,line
  146.     IF value='' THEN
  147.         RETURN
  148.     PARSE VAR value Type ',' Name ',' Kind
  149.     UPPER Type
  150.     UPPER Kind
  151.     SELECT
  152.         WHEN ABBREV('INFO',Type) THEN        ToolNumber=1
  153.         WHEN ABBREV('BROWSE',Type) THEN    ToolNumber=2
  154.         WHEN ABBREV('EDIT',Type) THEN        ToolNumber=3
  155.         WHEN ABBREV('PRINT',Type) THEN    ToolNumber=4
  156.         WHEN ABBREV('MAIL',Type) THEN        ToolNumber=5
  157.         OTHERWISE
  158.             CALL Error('Error in line' line ': Unknown tool type',10)
  159.     END
  160.     SELECT
  161.         WHEN ABBREV('CLI',Kind) THEN                Tools.ToolNumber.Flags=1
  162.         WHEN ABBREV('WORKBENCH',Kind) THEN    Tools.ToolNumber.Flags=2
  163.         WHEN ABBREV('AREXX',Kind) THEN            Tools.ToolNumber.Flags=3
  164.         OTHERWISE
  165.             CALL Error('Error in line' line ': Unknown kind of tool',10)
  166.     END
  167.     IF Name='' THEN
  168.         CALL Error('Error in line' line ': <ToolName> must not be null',10)
  169.     Tools.ToolNumber.Program=Name
  170.     Tools.ToolNumber.Exists=1
  171. RETURN
  172.  
  173. ParseTag:    PROCEDURE EXPOSE Tags.
  174.     PARSE ARG value,line
  175.     IF value='' THEN
  176.         RETURN
  177.     Counter=Tags.Count
  178.     PARSE UPPER VAR value TagName ',' TagValue
  179.     IF TagName='' | TagValue='' THEN
  180.         CALL Error('Error in line' line ': <TagName> or <TagValue> empty',10)
  181.     IF SUBSTR(TagName,1,1)='$' THEN DO
  182.         IF ~DATATYPE(SUBSTR(TagName,2),'X') THEN
  183.             CALL Error('Error in line' line ': <TagName> not numeric',10)
  184.         ELSE
  185.             Tags.Counter.Name=X2C(SUBSTR(TagName,2))
  186.     END
  187.     ELSE DO
  188.         IF ~DATATYPE(TagName,'W') THEN
  189.             CALL Error('Error in line' line ': <TagName> not numeric',10)
  190.         ELSE
  191.             Tags.Counter.Name=D2C(TagName)
  192.     END
  193.     IF SUBSTR(TagValue,1,1)='$' THEN DO
  194.         IF ~DATATYPE(SUBSTR(TagValue,2),'X') THEN
  195.             CALL'Error in line' line ': <TagValue> not numeric',10)
  196.         ELSE
  197.             Tags.Counter.Val=X2C(SUBSTR(TagValue,2))
  198.     END
  199.     ELSE DO
  200.         IF ~DATATYPE(TagValue,'W') THEN
  201.             CALL Error('Error in line' line ': <TagValue> not numeric',10)
  202.         ELSE
  203.             Tags.Counter.Val=D2C(TagValue)
  204.     END
  205.     Tags.Count=Tags.Count+1
  206. RETURN
  207.  
  208. CDecode: PROCEDURE
  209.     PARSE ARG encoded,line
  210.     Decoded=''
  211.     DO I=1 TO LENGTH(encoded)
  212.         IF SUBSTR(encoded,I,1)='\' THEN DO
  213.             I=I+1
  214.             SELECT
  215.                 WHEN SUBSTR(encoded,I,1)='?' THEN
  216.                     Decoded=Decoded||'FFFF'X
  217.                 WHEN SUBSTR(encoded,I,1)='\' THEN
  218.                     Decoded=Decoded||'00'X||'\'
  219.                 WHEN SUBSTR(encoded,I,1)='$' THEN DO
  220.                     Hex=SUBSTR(encoded,I+1,2)
  221.                     IF DATATYPE(Hex,'X') THEN DO
  222.                         Decoded=Decoded||'00'X||X2C(Hex)
  223.                         I=I+2
  224.                     END
  225.                     ELSE
  226.                         CALL Error('Error in line' line ": Hexadecimal number expected after '$'",10)
  227.                 END
  228.                 OTHERWISE
  229.                     CALL Error('Error in line' line ': Unknown escape character',10)
  230.             END
  231.         END
  232.         ELSE
  233.             Decoded=Decoded||'00'X||SUBSTR(encoded,I,1)
  234.     END
  235. RETURN Decoded
  236.  
  237. Check:    PROCEDURE EXPOSE Header.
  238.     PARSE ARG file
  239.     IF file='' THEN
  240.         CALL Error('Error: <DestFile> must not be null',10)
  241.     IF Header.Name='' | Header.BaseName='' THEN
  242.         CALL Error('Error: <Name> and <BaseName> must not be null',10)
  243.     IF Header.GroupID='' | Header.ID='' THEN
  244.         CALL Error('Error: <GroupID> and <FileID> must not be null',10)
  245.     IF Header.Pattern='' & Header.Mask='' THEN
  246.         CALL Error('Warning: Both <Pattern> and <Mask> are null',5)
  247. RETURN
  248.  
  249. Write:    PROCEDURE EXPOSE Header. Code. Tools. Tags.
  250.     TAB='09'X
  251.     SAY 'Version:   '||Header.VerString
  252.     SAY 'Name:      '||Header.Name
  253.     SAY 'Base name: '||Header.BaseName
  254.     SAY 'Group ID:  '||Header.GroupID
  255.     SAY 'ID:        '||Header.ID
  256.     SAY 'Pattern:   '||Header.Pattern
  257.     SAY 'Mask len:  '||Header.MaskLen
  258.     SAY 'Mask:      '||Header.Mask
  259.     SAY 'Flags:     '||Header.Flags
  260.     SAY 'Priority:  '||Header.Priority
  261.     SAY
  262.     IF Code.Name~='' THEN
  263.     DO
  264.         SAY 'Function name: '||Code.Name
  265.         SAY
  266.     END
  267.     DO I=1 TO 5
  268.         IF Tools.I.Exists THEN
  269.         DO
  270.             SAY 'Tool name:   ' Tools.I.Program
  271.             SAY 'Type of tool:' I
  272.             SAY 'Kind of tool:' Tools.I.Flags
  273.             SAY
  274.         END
  275.     END
  276.     DO I=1 TO Tags.Count-1
  277.         SAY 'Tag name:' C2X(Tags.I.Name) 'Tag value:' C2D(Tags.I.Val)
  278.     END
  279. RETURN
  280.  
  281. WriteFile:    PROCEDURE EXPOSE Header. Code. Tools. Tags.
  282.     PARSE ARG file
  283.     Header.Name=Header.Name||'0'X
  284.     Header.BaseName=Header.BaseName||'0'X
  285.     Header.Pattern=Header.Pattern||'0'X
  286.     Header.VerString=Header.VerString||'0'X
  287.     DO I=1 TO 5
  288.         Tools.I.Program=Tools.I.Program||'0'X
  289.     END
  290.     NameLen=Len(FilePart(file))
  291.     VerLen=Len(Header.VerString)
  292.     HeaderLen=Len(Header.Name)+Len(Header.BaseName)+Len(Header.Pattern)
  293.     HeaderLen=HeaderLen+32+Header.MaskLen*2
  294.     CodeLen=Len(Code.Code)
  295.     DO I=1 TO 5
  296.         ToolLen.I=8+Len(Tools.I.Program)
  297.     END
  298.     TagsLen=(Tags.Count-1)*8
  299.     TagsExist=Tags.Count>1
  300.     TotalLen=4
  301.     TotalLen=TotalLen+8+NameLen
  302.     TotalLen=TotalLen+8+HeaderLen
  303.     TotalLen=TotalLen+(8+CodeLen)*Code.Exists
  304.     DO I=1 TO 5
  305.         TotalLen=TotalLen+(8+ToolLen.I)*Tools.I.Exists
  306.     END
  307.     TotalLen=TotalLen+(8+TagsLen)*TagsExist
  308.     IF ~OPEN(FH,file,'W') THEN
  309.         CALL Error('Unable to open output file' file,20)
  310.  
  311.     /* Save header */
  312.     CALL WRITECH(FH,'FORM')
  313.     CALL WRITECH(FH,Long(TotalLen))
  314.     CALL WRITECH(FH,'DTYP')
  315.  
  316.     /* Save FVER chunk */
  317.     IF Header.VerString~='0'X THEN
  318.     DO
  319.         CALL WRITECH(FH,'FVER')
  320.         CALL WRITECH(FH,Long(VerLen))
  321.         CALL WRITECH(FH,Pad(Header.VerString))
  322.     END
  323.  
  324.     /* Save NAME chunk */
  325.     CALL WRITECH(FH,'NAME')
  326.     CALL WRITECH(FH,Long(NameLen))
  327.     CALL WRITECH(FH,Pad(FilePart(file)))
  328.  
  329.     /* Save DTHD chunk */
  330.     CALL WRITECH(FH,'DTHD')
  331.     CALL WRITECH(FH,Long(HeaderLen))
  332.     CALL WRITECH(FH,Long(32+Header.MaskLen*2))
  333.     CALL WRITECH(FH,Long(32+Header.MaskLen*2+Len(Header.Name)))
  334.     CALL WRITECH(FH,Long(32+Header.MaskLen*2+Len(Header.Name)+Len(Header.BaseName)))
  335.     CALL WRITECH(FH,Long(32))
  336.     CALL WRITECH(FH,PadR(Header.GroupID))
  337.     CALL WRITECH(FH,PadR(Header.ID))
  338.     CALL WRITECH(FH,Word(Header.MaskLen))
  339.     CALL WRITECH(FH,Word(0))
  340.     CALL WRITECH(FH,Word(Header.Flags))
  341.     CALL WRITECH(FH,Word(Header.Priority))
  342.     CALL WRITECH(FH,Header.Mask)
  343.     CALL WRITECH(FH,Pad(Header.Name))
  344.     CALL WRITECH(FH,Pad(Header.BaseName))
  345.     CALL WRITECH(FH,Pad(Header.Pattern))
  346.  
  347.     /* Save DTCD chunk */
  348.     IF Code.Exists THEN
  349.     DO
  350.         CALL WRITECH(FH,'DTCD')
  351.         CALL WRITECH(FH,Long(CodeLen))
  352.         CALL WRITECH(FH,Pad(Code.Code))
  353.     END
  354.  
  355.     /* Save DTTL chunk */
  356.     DO I=1 TO 5    
  357.         IF Tools.I.Exists THEN
  358.         DO
  359.             CALL WRITECH(FH,'DTTL')
  360.             CALL WRITECH(FH,Long(ToolLen.I))
  361.             CALL WRITECH(FH,Word(I))
  362.             CALL WRITECH(FH,Word(Tools.I.Flags))
  363.             CALL WRITECH(FH,Long(8))
  364.             CALL WRITECH(FH,Pad(Tools.I.Program))
  365.         END
  366.     END
  367.  
  368.     /* Save DTTG chunk */
  369.     IF Tags.Count>1 THEN DO
  370.         CALL WRITECH(FH,'DTTG')
  371.         CALL WRITECH(FH,Long(TagsLen))
  372.         DO I=1 To Tags.Count-1
  373.             CALL WRITECH(FH,RIGHT(Tags.I.Name,4,'0'X)||RIGHT(Tags.I.Val,4,'0'X))
  374.         END
  375.     END
  376.     
  377.     SAY 'DataType written!'
  378. RETURN
  379.  
  380. Error:    PROCEDURE
  381.     PARSE ARG string,code
  382.     SAY string
  383.     IF code>5 THEN
  384.         EXIT code
  385.     ELSE
  386.         RETURN
  387.  
  388.  
  389. /*
  390. **    Utility procedures
  391. */
  392. Len:    PROCEDURE
  393.     PARSE ARG string
  394.     L=LENGTH(string)
  395.     IF L//2=0 THEN
  396.         RETURN L
  397.     ELSE
  398.         RETURN L+1
  399.  
  400. Pad:    PROCEDURE
  401.     PARSE ARG string
  402.     L=LENGTH(string)
  403.     IF L//2=0 THEN
  404.         RETURN string
  405.     ELSE
  406.         RETURN string||'00'X
  407.  
  408. PadR:    PROCEDURE
  409.     PARSE ARG string
  410. RETURN LEFT(string,4,'0'X)
  411.  
  412. Word:    PROCEDURE
  413.     PARSE ARG num .
  414. RETURN RIGHT(D2C(num),2,'0'X)
  415.  
  416. Long:    PROCEDURE
  417.     PARSE ARG num .
  418. RETURN RIGHT(D2C(num),4,'0'X)
  419.  
  420. FilePart:    PROCEDURE
  421.     PARSE ARG path
  422.     SepPos=Max(LastPos('/',path),LastPos(':',path))+1
  423.     PARSE VAR path PathPart =SepPos FilePart
  424. RETURN FilePart
  425.  
  426. MakeDate:    PROCEDURE
  427.     PARSE VALUE Date('E') WITH day '/' month '/' year
  428.     IF LEFT(day,1)='0'     THEN    PARSE VAR day '0' day
  429.     IF LEFT(month,1)='0' THEN    PARSE VAR month '0' month
  430. RETURN day'.'month'.'year
  431.     
  432.  
  433. BREAK_C:
  434.     SAY 'DataType not written!'
  435.     EXIT
  436.